Aminet 1 (Walnut Creek)/Aminet - June 1993 [Walnut Creek].iso/usenet/sources/volume89/aplictns/hp11.3

Internet Message Format | 1989-11-13 | 60KB

Path: xanth!lll-winken!brutus.cs.uiuc.edu!wuarchive!texbell!texsun!newstop!sun!swap!page
From: [e-mail] (Bob Page)
Newsgroups: comp.sources.amiga
Subject: v89i200:  hp11 calculator emulator v1.01, Part03/03
Message-ID: <[e-mail]>
Date: 13 Nov 89 01:36:13 GMT
Sender: [e-mail]
Lines: 2644
Approved: [e-mail]

Submitted-by: [e-mail] (David Gay)
Posting-number: Volume 89, Issue 200
Archive-name: applications/hp11.3

# This is a shell archive.
# Remove anything above and including the cut line.
# Then run the rest of the file through 'sh'.
# Unpacked files will be owned by you and have default permissions.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar: SHell ARchive
# Run the following text through 'sh' to create:
#    ins.c
#    ins.h
#    io.c
#    io.h
#    kbd.c
#    kbd.h
#    lmkdebug
#    lmkfile
#    o/dummy
#    od/dummy
#    prog_codes.c
#    prog_codes.h
#    support.c
#    support.h
# This is archive 3 of a 3-part kit.
# This archive created: Sun Nov 12 17:33:21 1989
echo "extracting ins.c"
sed 's/^X//' << \SHAR_EOF > ins.c
X#include "exec/types.h"
X#include "proto/dos.h"
X
X#include "math.h"
X#include "string.h"
X#include "stdio.h"
X
X#include "hp11/amiga/amiga.h"
X#include "hp11/hp11.h"
X#include "hp11/io.h"
X#include "hp11/support.h"
X#include "hp11/ins.h"
X#include "hp11/codes.h"
X
X#define FOREVER() for(;;)
X
X/* Declare the modules variables */
XBOOL enabled, entering, overflow;
X
XBOOL expo, decpt;
Xchar strx[13], expx[4];
X
X/* Function addresses */
XHP11Function insfunc[KCOMPLEX] =
X{
X   Sqrt,
X   Exp,
X   Exp10,
X   ExpYX,
X   Invert,
X   DoCHS,
X   Divide,
X   SIN,
X   COS,
X   TAN,
X   DoEEX,
X   Times,
X   RunStart,
X   Rdn,
X   ExgXY,
X   ENTER,
X   Minus,
X   DoPoint,
X   SigmaPlus,
X   Plus,
X
X   Pi,
X   XleY,
X   ExgXInd,
X   ToRect,
X   ExgXI,
X   DSE,
X   ISG,
X   XgtY,
X   PSE,
X   ClearSigma,
X   ClearReg,
X   Random,
X   DoPerm,
X   ToHMS,
X   ToRAD,
X   XneY,
X   FRAC,
X   Fact,
X   Estimate,
X   LinearRegression,
X   XeqY,
X
X   Sqr,
X   LN,
X   LOG,
X   Percent,
X   DeltaPercent,
X   ABS,
X   DEG,
X   RAD,
X   GRAD,
X   Xlt0,
X   ArcSIN,
X   ArcCOS,
X   ArcTAN,
X   ToPolar,
X   Xgt0,
X   RTN,
X   Rup,
X   RND,
X   CLX,
X   LSTX,
X   DoComb,
X   ToH,
X   ToDEG,
X   Xne0,
X   INT,
X   Mean,
X   SDev,
X   SigmaSub,
X   Xeq0,
X
X   STORandom,
X   RCLSigma,
X
X   HypSIN,
X   HypCOS,
X   HypTAN,
X
X   ArcHypSIN,
X   ArcHypCOS,
X   ArcHypTAN
X};
X
X/* Various functions used to conserve code space. Could be macros or simply
X  instructions */
Xvoid DISABLE() { enabled = FALSE; entering = FALSE; }
X
Xvoid ENABLE() { enabled = TRUE; entering = FALSE; }
X
Xvoid LisX(void)
X{
X   L = X;
X}
X
Xvoid XisY(void)
X{
X   X = Y;
X}
X
Xvoid YisX(void)
X{
X   Y = X;
X}
X
Xvoid YisZ(void)
X{
X   Y = Z;
X}
X
Xvoid ZisY(void)
X{
X   Z = Y;
X}
X
Xvoid ZisT(void)
X{
X   Z = T;
X}
X
Xvoid TisZ(void)
X{
X   T = Z;
X}
X
X/* Check r against HP11 limits */
Xdouble Check(r)
Xdouble r;
X{
X   if (fabs(r) > MAXHP11) {
X      r = MAXHP11 * sign(r);
X      overflow = TRUE; /* Overflow has occured */
X   }
X   else if (fabs(r) < MINHP11) r = 0.0;
X
X   return(r);
X}
X
Xvoid Drop(void) /* Drop stack & save X in L */
X{
X   ENABLE();
X   LisX(); XisY(); YisZ(); ZisT();
X/* L = X(); X = Y; Y = Z; Z = T; */
X}
X
Xvoid Enter(void) /* Move stack up */
X{
X   TisZ(); ZisY(); YisX();
X/* T = Z; Z = Y; Y = X; */
X}
X
Xvoid Lift(void) /* lift stack if enabled, ENABLE stack */
X{
X   if (enabled) Enter();
X   ENABLE();
X}
X
Xvoid SaveX(void) /* Frequent: L = X; ENABLE(); (most simple instructions eg sin do this) */
X{
X   LisX();
X   ENABLE();
X}
X
X/* Convert x from current trig setting to radians */
Xdouble from(double x)
X{
X   switch (Angles) {
X      case deg:return(FDEG(x));
X      case rad:return(x);
X      case grad:return(FGRAD(x));
X   }
X}
X
X/* Convert radian value to current trig setting */
Xdouble toa(double x)
X{
X   switch (Angles) {
X      case deg:return(TDEG(x));
X      case rad:return(x);
X      case grad:return(TGRAD(x));
X   }
X}
X
X/* Used by statistical formulae (terminology from HP11 doc) */
Xdouble M(void) { return(R[0] * R[2] - R[1] * R[1]); }
X#define N() (R[0] * R[4] - R[3] * R[3]) /* used only once */
Xdouble P(void) { return(R[0] * R[5] - R[1] * R[3]); }
X
Xdouble *Reg(int n) /* Return address of register n */
X{
X   if (n == OI) return(&I);
X   else if (n == OIND_R) /* indirection */
X      if (I >= 0.0 && I < 20.0) return(R + (int)I);
X      else return(NULL); /* Unknown reg */
X   else return(R + n);
X}
X
X/* Convert current input value to real, return false if fails (no exponent) */
Xvoid StdVal(void)
X{
X   X = atof(strx);
X}
X
X/* Convert current input value to real, return false if fails (exponent) */
Xvoid ExpoVal(void)
X{
X   char buf[80];
X
X   /* buf = strx + "E" + expx, with leading blanks stripped from expx */
X   strcat(strcat(strcpy(buf,strx),"E"), stpblk(expx));
X
X   X = atof(buf);
X}
X
X/* Act on key to modify current input value */
Xvoid EnterNum(key)
Xregister int key;
X{
X   register int lens;
X
X   if (!entering) { /* No current digit entry */
X      if (enabled) Enter(); /* lift stack ? */
X      entering = enabled = TRUE; /* stack enabled, number being entered */
X      expo = decpt = FALSE; /* No dec point or exponent */
X      strx[0] = ' '; strx[1] = '\0'; /* nb string empty (leading space for sign) */
X   }
X
X   lens = strlen(strx); /* Current string length */
X   if (key >= KFIG + 0 && key <= KFIG + 9) /* Add digit */
X      if (expo) { /* to exponent */
X     expx[1] = expx[2]; expx[2] = key - KFIG + '0';
X      }
X      else {
X     strx[lens] = key - KFIG + '0'; strx[lens + 1] = '\0';
X     strx[scrpos(strx, 11) + 1] = '\0'; /* Cut string at end of hp11 screen pos
X        ==> prevent display overflow */
X      }
X   else
X      switch (key) {
X     case -IBACK: /* back-arrow, actions are passed as negative numbers to
X        distinguish them from instructions */
X        if (expo) /* Correct exponent */
X           if (strcmp(expx, "-00") == 0) strcpy(expx, " 00");
X           else if (strcmp(expx, " 00") == 0) expo = FALSE; /* delete exponent */
X           else {
X          expx[2] = expx[1]; expx[1] = '0';
X           }
X        else /* no exponent */
X           if (lens == 2) { CLX(); return; } /* end of digit entry,
X          must not evaluate current entry ==> exit */
X           else {
X          if (strx[lens - 1] == '.') decpt = FALSE;
X          strx[lens - 1] = '\0'; /* cut last char from str by moving eos mark */
X           }
X        break;
X     case KCHS:
X        if (expo) { /* change exponent sign */
X           expx[0] = (expx[0] == '-') ? ' ' : '-';
X        }
X        else { /* change number sign */
X           strx[0] = (strx[0] == '-') ? ' ' : '-';
X        }
X        break;
X     case KPOINT:
X        if (!expo && !decpt) {
X           decpt = TRUE;
X
X           if (lens == 1) { strcpy(strx, " 0"); lens = 2; } /* if no digit entered, add a 0 */
X           strx[lens] = '.'; strx[lens + 1] = '\0';
X           strx[scrpos(strx, 11) + 1] = '\0';
X        }
X        break;
X     case KEEX:
X        if (!expo) {
X           expo = TRUE;
X           strcpy(expx, " 00");
X           if (lens == 1) strcpy(strx, " 1"); /* if no digit entered, add a 1 */
X        }
X      }
X   if (expo) ExpoVal();
X   else StdVal();
X}
X
Xvoid ExpYX() /* y^x */
X{
X   double t;
X
X   errno = 0; /* set return code to 0 */
X   t = pow(Y, X);
X   if (errno != 0) Error('0'); /* Check math library return code */
X   else {
X      Y = t;
X      Drop();
X   }
X}
X
Xvoid CHS(void)
X{
X   ENABLE();
X   X = -X;
X}
X
Xvoid DoCHS()
X{
X   if (entering) EnterNum(KCHS);
X   else CHS();
X}
X
Xvoid DoEEX()
X{
X   EnterNum(KEEX);
X}
X
Xvoid DoPoint()
X{
X   EnterNum(KPOINT);
X}
X
Xvoid Rdn()
X{
X   double t;
X
X   ENABLE();
X   t = X; XisY(); YisZ(); ZisT(); T = t;
X/* t = X; X = Y; Y = Z; Z = T; T = t; */
X}
X
Xvoid ExgXY() /* Exchange X & Y */
X{
X   double t;
X
X   ENABLE();
X   t = X; XisY(); Y = t;
X/* t = X; X = Y; Y = t; */
X}
X
Xvoid ClearReg()
X{
X   int i;
X
X   NEUTRAL();
X   for (i = 0; i < 20; i++) R[i] = 0.0;
X   I = 0;
X}
X
Xvoid Estimate() /* Statistics: estimate y from given x */
X{
X   double tm = M(), tr, ty, tp = P(); /* temporary results */
X
X   tr = tm * N();
X   ty = R[0] * tm;
X
X   if (tr < 0.0 || ty == 0.0) Error('2'); /* Stat error */
X   else {
X      Enter(); /* always lifts stack */
X      SaveX();
X
X      X = (tm * R[3] + tp * (R[0] * X - R[1])) / ty; /* estimate */
X      Y = tp / sqrt(tr); /* Correlation coefficient */
X   }
X}
X
Xvoid LinearRegression()
X{
X   double tm = M(), tp = P();
X
X   if (tm == 0.0 || R[0] == 0.0) Error('2');
X   else {
X      Lift(); /* Lift stack twice */
X      Enter();
X
X      Y = tp / tm;
X      X = (tm * R[3] - tp * R[1]) / (R[0] * tm);
X   }
X}
X
Xvoid Rup()
X{
X   double t;
X
X   ENABLE();
X   t = T; TisZ(); ZisY(); YisX(); X = t;
X/* t = T; T = Z; Z = Y; Y = X; X = t; */
X}
X
Xvoid SDev()
X{
X   double tx, ty, td;
X
X   td = R[0] * (R[0] - 1.0);
X
X   if (td == 0.0) Error('2');
X   else {
X      tx = M() / td;
X      ty = N() / td;
X
X      if (tx < 0.0 || ty < 0.0) Error('2');
X      else {
X     Lift();
X     Enter();
X
X     X = sqrt(tx); Y = sqrt(ty);
X      }
X   }
X}
X
Xvoid FIX(n)
Xint n;
X{
X   NEUTRAL();
X   Mode = fix; Digits = n;
X   minfix = pow(10.0, (double)-Digits);
X}
X
Xvoid SCI(n)
Xint n;
X{
X   NEUTRAL();
X   Mode = sci; Digits = n;
X}
X
Xvoid ENG(n)
Xint n;
X{
X   NEUTRAL();
X   Mode = eng; Digits = n;
X}
X
Xvoid ExgXI() /* Exchange X with I */
X{
X   double t;
X
X   ENABLE();
X   t = I; I = X; X = t;
X}
X
Xvoid ExgXInd() /* Exchange X with (i) */
X{
X   double t, *ptr;
X
X   if (!(ptr = Reg(OIND_R))) Error('3'); /* get address of pointed register if exists */
X   else {
X      ENABLE();
X      t = *ptr; *ptr = X; X = t;
X   }
X}
X
Xvoid STO(n, type)
Xint n;
Xenum StoTypes type;
X{
X   double val;
X   register double *ptr;
X
X   if (ptr = Reg(n)) { /* Valid register */
X
X      switch (type) {
X     case sto: val = X; break;
X     case add: val = *ptr + X; break;
X     case sub: val = *ptr - X; break;
X     case mul: val = *ptr * X; break;
X     case div: if (X == 0.0) {
X              Error('0');
X              return; /* exit if error */
X           }
X           else val = *ptr / X; break;
X      }
X
X      if (fabs(val) > MAXHP11) Error('1'); /* Register overflow */
X      else {
X     *ptr = val;
X     ENABLE();
X      }
X   }
X   else Error('3');
X}
X
Xvoid RCL(n)
Xint n;
X{
X   double *ptr;
X
X   if (ptr = Reg(n)) {
X      Lift();
X      X = *ptr;
X   }
X   else Error('3');
X}
X
Xvoid GTOLine(n) /* move to line n */
Xint n;
X{
X   if (n >= 0 && n <= lastIns) PC = n;
X   else Error('4');
X}
X
Xvoid ProgramEntry() /* Enter a program */
X{
X   register int i;
X   WORD code;
X   register int inprog = TRUE;
X
X   RelKey();
X
X   ENABLE();
X
X   do {
X      DisplayLine(); DispPRGM(TRUE); /* Program display */
X
X      switch (ReadKey(&code)) {
X     case Instruction: /* Save it */
X        if (lastIns == MAXPROG) Error('4'); /* Memory full */
X        else {
X           for (i = lastIns; i > PC; i--) Prog[i + 1] = Prog[i]; /* Move program up */
X           lastIns++;
X           Prog[++PC] = code; /* store instruction */
X           retCnt = 0; /* Empty return stack */
X        };
X        break;
X     case Action: /* Act on it */
X        if (code >= IGTO_LINE) GTOLine(code - IGTO_LINE);
X        else switch (code) {
X           case ION: on = inprog = !RelKey(); break; /* Allow user to change his mind */
X           case IP_R: case IRESET: inprog = FALSE; break; /* exit program mode */
X           case IMEM: MEM(); break;
X           case IBACK: /* delete line */
X          if (PC != 0) {
X             for (i = PC; i < lastIns; i++) Prog[i] = Prog[i + 1]; /* del line */
X             lastIns--;
X             PC--;
X             retCnt = 0; /* empty stack when prog changed */
X          }
X          break;
X           case ISST: if (PC++ == lastIns) PC = 0; break;
X           case IBST: if (PC-- == 0) PC = lastIns; break;
X           case IUSER: USER(); break;
X           case ICLR_PRGM: lastIns = PC = 0; break;
X        }
X        break;
X      }
X      RelKey();
X   } while (inprog);
X}
X
Xvoid GTOLBL(int n)
X{
X   register int i;
X
X   if (n > 14) Error('4');
X   else { /* Do a circular search from current line */
X      for (i = PC + 1; i <= lastIns; i++) /* Search from current line */
X     if (Prog[i] == KLBL + n) {
X        PC = i; return; /* found, exit */
X     }
X      for (i = 1; i < PC; i++) /* If that fails, search from start */
X     if (Prog[i] == KLBL + n) {
X        PC = i; return;
X     }
X      Error('4');
X   }
X}
X
Xvoid GTO(n)
Xint n;
X{
X   if (n == OIND_G) /* Indirection */
X      if (I >= 0.0) GTOLBL((int)I); /* gto label if I >= 0 */
X      else GTOLine(-(int)I); /* gto line -I if i < 0 */
X   else GTOLBL(n);
X   if (!error) { /* success */
X      ENABLE();
X      if (running) PC--; /* Execute label instruction (even though useless),
X     must decrement PC in run mode because incremented after end ins */
X      else retCnt = 0; /* in normal mode, GTO clears return stack */
X   }
X}
X
Xvoid BreakupI(int *limit, int *step) /* From I deduce loop limit & step.
X I is stored as nnnnn.lllss with nnnnn as the loop count, lll the limit &
X ss the step. If ss == 0, the step is taken as 1 */
X{
X   double t;
X
X   t = frac(I) * 1000.0;
X   *limit = (int)t;
X   *step = (int)(100.0 * (t - *limit));
X   if (*step == 0) *step = 1;
X}
X
Xvoid DSE()
X{
X   int limit, step;
X
X   ENABLE();
X   BreakupI(&limit, &step);
X   I -= step;
X
X   skip = (I <= limit);
X}
X
Xvoid ISG()
X{
X   int limit, step;
X
X   ENABLE();
X   BreakupI(&limit, &step);
X   I += step;
X
X   skip = (I > limit);
X}
X
Xvoid SF(n)
Xint n;
X{
X   ENABLE();
X   Flags |= (1 << n);
X}
X
Xvoid CF(n)
Xint n;
X{
X   ENABLE();
X   Flags &= ~(1 << n);
X}
X
Xvoid Set(n) /* Is flag n set ? */
Xint n;
X{
X   ENABLE();
X   skip = !(Flags & (1 << n));
X}
X
Xvoid PSE()
X{
X   BOOL oldrun = running;
X
X   NEUTRAL();
X   running = FALSE;
X   Disp();
X   Wait50(50);
X   running = oldrun;
X}
X
Xvoid RTN()
X{
X   ENABLE();
X   if (!running || retCnt == 0) { /* In normal mode RTN sets PC to 0 &
X      clears the return stack. In run mode, if the stack is empty, it also
X      sets PC to 0 & then it interrupts the program */
X      running = FALSE;
X      PC = 0; retCnt = 0;
X   }
X   else /* Return from subroutine */
X      PC = retStack[--retCnt];
X}
X
Xvoid GSB(n)
Xint n;
X{
X   if (retCnt == MAXSTACK) Error('5'); /* Stack full */
X   else {
X      if (running) {
X     retStack[retCnt++] = PC; /* Save PC */
X     GTO(n); /* Jump to prog line */
X     if (error) retCnt--; /* If this fails, reclaim stack space */
X      }
X      else { /* in normal mode, GSB = GTO + R/S */
X     retCnt = 0;
X     GTO(n);
X     running = !error;
X      }
X   }
X}
X
Xvoid HP11ColdReset() /* ColdReset HP11 (Menu option: New) */
X{
X   Display("  Pr Error");
X
X   DEG();
X   FIX(4);
X   PC = lastIns = 0;
X   running = User = comma = FALSE;
X   Flags = retCnt = 0;
X   ClearSigma(); L = 0.0;
X   ClearReg();
X
X   GetKey();
X}
X
Xvoid MEM() /* Display available memory */
X{
X   char mem[20];
X
X   NEUTRAL();
X   sprintf(mem, " P-%-4dr- .9", MAXPROG - lastIns);
X   /* There are always all the register hence the r- .9, %-4d left justifies the number
X     of lines in a 4 character field */
X   Display(mem);
X   RelKey();
X}
X
Xvoid PREFIX() /* Display digits of number in x */
X{
X   char *disp, buf[20];
X   int dec, sign;
X
X   NEUTRAL();
X
X   if (X != 0.0) {
X      disp = ecvt(X, 10, &dec, &sign); /* The ideal library function for this */
X      buf[0] = ' '; strcpy(buf + 1, disp);
X      Display(buf);
X   }
X   else Display(" 0000000000");
X
X   RelKey();
X}
X
Xvoid RND()
X{
X   double fx, tx;
X   char buf[20];
X
X   SaveX();
X
X   switch (Mode) {
X      case fix:
X     fx = modf(X, &tx);
X     X = tx + trunc(fx / minfix + 0.5) * minfix;
X     break;
X      case sci: case eng:
X     sprintf(buf, "%0.*e", Digits, X);
X     X = atof(buf);
X     break;
X   }
X}
X
Xvoid Sqrt()
X{
X   if (X < 0.0) Error('0');
X   else {
X      SaveX(); X = sqrt(X);
X   }
X}
X
Xvoid Exp() /* e^x */
X{
X   SaveX(); X = exp(X);
X}
X
Xvoid Exp10() /* 10^x */
X{
X   SaveX(); X = pow(10.0, X);
X}
X
Xvoid Invert() /* 1/x */
X{
X   if (X == 0.0) Error('0');
X   else {
X      SaveX(); X = 1.0 / X;
X   }
X}
X
Xvoid Divide()
X{
X   if (X == 0.0) Error('0');
X   else {
X      Y = Y / X;
X      Drop();
X   }
X}
X
Xvoid SIN()
X{
X   SaveX(); X = sin(from(X));
X}
X
Xvoid COS()
X{
X   SaveX(); X = cos(from(X));
X}
X
Xvoid TAN()
X{
X   SaveX(); X = tan(from(X));
X}
X
Xvoid Times()
X{
X   Y = Y * X;
X   Drop();
X}
X
Xvoid ENTER()
X{
X   DISABLE();
X   Enter();
X}
X
Xvoid Minus()
X{
X   Y = Y - X;
X   Drop();
X}
X
Xvoid SigmaPlus() /* Accumulate statistics */
X{
X   R[0] += 1.0;
X   R[1] = Check(R[1] + X);
X   R[2] = Check(R[2] + X * X);
X   R[3] = Check(R[3] + Y);
X   R[4] = Check(R[4] + Y * Y);
X   R[5] = Check(R[5] + X * Y);
X
X   DISABLE();
X   LisX(); X = R[0];
X}
X
Xvoid Plus()
X{
X   Y = Y + X;
X   Drop();
X}
X
Xvoid Pi()
X{
X   Lift();
X   X = PI;
X}
X
X
Xvoid ToRect()
X{
X   SaveX();
X   Rect(X, from(Y), &X, &Y);
X}
X
Xvoid ClearSigma() /* Clear statistics */
X{
X   NEUTRAL(); /* Doesn't really matter, could be anything (but the HP11 doc says
X      neutral so it will be neutral ... */
X   X = Y = Z = T = R[0] = R[1] = R[2] = R[3] = R[4] = R[5] = 0.0;
X}
X
Xvoid Random() /* Random number generator. This isn't the same as the HP11 one, for I
X   don't know what the HP11 uses. */
X{
X   Lift();
X   X = drand48();
X}
X
Xvoid DoPerm() /* P y,x */
X{
X   if (X <= Y && X > 0.0) {
X      Y = Perm((int)Y, (int)X);
X      Drop();
X   }
X   else Error('0');
X}
X
Xvoid ToHMS()
X{
X   SaveX(); X = hms(X);
X}
X
Xvoid ToRAD()
X{
X   SaveX(); X = FDEG(X);
X}
X
Xvoid FRAC()
X{
X   SaveX(); X = frac(X);
X}
X
Xvoid Fact() /* gamma/factorial function */
X{
X   SaveX();
X   if (X > MAXFACT) X = MAXHP11;
X   else if (X >= 0 && X == trunc(X)) X = factorial((int)X);
X   else X = gamma(1.0 + X);
X}
X
Xvoid Sqr()
X{
X   SaveX(); X = X * X;
X}
X
Xvoid LN()
X{
X   if (X <= 0.0) Error('0');
X   else {
X      SaveX(); X = log(X);
X   }
X}
X
Xvoid LOG()
X{
X   if (X <= 0.0) Error('0');
X   else {
X      SaveX(); X = log10(X);
X   }
X}
X
Xvoid Percent()
X{
X   /* doesn't drop stack */
X   SaveX(); X = X * Y / 100.0;
X}
X
Xvoid DeltaPercent() /* Percentage of difference between x & y */
X{
X   if (Y == 0.0) Error('0');
X   else {
X      SaveX(); X = 100.0 * (X - Y) / Y;
X   }
X}
X
Xvoid ABS()
X{
X   SaveX(); X = fabs(X);
X}
X
X
Xvoid DEG()
X{
X   NEUTRAL();
X   Angles = deg;
X}
X
Xvoid RAD()
X{
X   NEUTRAL();
X   Angles = rad;
X}
X
Xvoid GRAD()
X{
X   NEUTRAL();
X   Angles = grad;
X}
X
Xvoid ArcSIN()
X{
X   if (fabs(X) > 1.0) Error('0');
X   else {
X      SaveX(); X = toa(asin(X));
X   }
X}
X
Xvoid ArcCOS()
X{
X   if (fabs(X) > 1.0) Error('0');
X   else {
X      SaveX(); X = toa(acos(X));
X   }
X}
X
Xvoid ArcTAN()
X{
X   SaveX(); X = toa(atan(X));
X}
X
Xvoid ToPolar()
X{
X   SaveX();
X   Polar(X, Y, &X, &Y);
X   Y = toa(Y);
X}
X
Xvoid CLX()
X{
X   X = 0.0;
X   DISABLE();
X}
X
Xvoid LSTX()
X{
X   Lift();
X   X = L;
X}
X
Xvoid DoComb() /* C y,x */
X{
X   if (X <= Y && X > 0.0) {
X      Y = Comb((int)Y, (int)X);
X      Drop();
X   }
X   else Error('0');
X}
X
Xvoid ToH()
X{
X   SaveX(); X = hr(X);
X}
X
Xvoid ToDEG()
X{
X   SaveX(); X = TDEG(X);
X}
X
Xvoid INT()
X{
X   SaveX(); X = trunc(X);
X}
X
Xvoid Mean()
X{
X   if (R[0] == 0.0) Error('2');
X   else {
X      Lift();
X      Enter();
X
X      X = R[1] / R[0];
X      Y = R[3] / R[0];
X   }
X}
X
Xvoid SigmaSub() /* Correct error in statistics accumulation */
X{
X   R[0] -= 1.0;
X   R[1] = Check(R[1] - X);
X   R[2] = Check(R[2] - X * X);
X   R[3] = Check(R[3] - Y);
X   R[4] = Check(R[4] - Y * Y);
X   R[5] = Check(R[5] - X * Y);
X
X   DISABLE();
X   LisX(); X = R[0];
X}
X
Xvoid HypSIN()
X{
X   SaveX(); X = sinh(X);
X}
X
Xvoid HypCOS()
X{
X   SaveX(); X = cosh(X);
X}
X
Xvoid HypTAN()
X{
X   SaveX(); X = tanh(X);
X}
X
Xvoid ArcHypSIN()
X{
X   SaveX(); X = asinh(X);
X}
X
Xvoid ArcHypCOS()
X{
X   if (fabs(X) < 1.0) Error('0');
X   else {
X      SaveX(); X = acosh(X);
X   }
X}
X
Xvoid ArcHypTAN()
X{
X   if (fabs(X) > 1.0) Error('0');
X   else {
X      SaveX(); X = atanh(X);
X   }
X}
X
Xvoid STORandom() /* Set random generator seed */
X{
X   ENABLE();
X   srand48((long)X);
X   /* Use integer part of seed, something better could be used */
X}
X
Xvoid RCLSigma() /* Recall accumulated x & y totals */
X{
X   Lift();
X   Enter();
X
X   X = R[1]; Y = R[3];
X}
X
Xvoid USER() /* Toggle user mode */
X{
X   NEUTRAL();
X   User = !User;
X}
X
Xvoid RunStart() /* Should be called RunStop ! */
X{
X   NEUTRAL();
X   if (running) running = FALSE; /* Stop */
X   else { /* Run */
X      if (lastIns != 0) { /* if a program to run */
X     running = TRUE;
X     if (PC == 0) PC = 1; /* skip first line */
X      }
X
X      DisplayLine(); /* Display first line */
X      RelKey();
X   }
X}
X
Xvoid XleY()
X{
X   ENABLE();
X   skip = (X > Y); /* skip if condition fails */
X}
X
Xvoid Xlt0()
X{
X   ENABLE();
X   skip = (X >= 0.0);
X}
X
Xvoid XgtY()
X{
X   ENABLE();
X   skip = (X <= Y);
X}
X
Xvoid Xgt0()
X{
X   ENABLE();
X   skip = (X <= 0.0);
X}
X
Xvoid XneY()
X{
X   ENABLE();
X   skip = (X == Y);
X}
X
Xvoid Xne0()
X{
X   ENABLE();
X   skip = (X == 0.0);
X}
X
Xvoid XeqY()
X{
X   ENABLE();
X   skip = (X != Y);
X}
X
Xvoid Xeq0()
X{
X   ENABLE();
X   skip = (X != 0.0);
X}
X
Xvoid SST() /* Single step a program */
X{
X   if (lastIns == 0) { /* No program to single step through */
X      DisplayLine();
X      RelKey();
X   }
X   else {
X      if (PC == 0) PC = 1; /* skip line 0 */
X
X      DisplayLine();
X      RelKey();
X
X      running = TRUE; /* Pretend line is being run */
X      ExecIns(Prog[PC]); /* Exec ins */
X      if (!error && !overflow) { /* idem main loop */
X     if (skip) PC++;
X     PC++;
X     while (PC > lastIns) {
X        RTN();
X        PC++;
X     }
X      }
X      running = FALSE;
X
X   }
X}
X
Xvoid BST() /* move back one line (but don't correct its effect) */
X{
X   if (PC == 0) PC = lastIns;
X   else PC--;
X
X   DisplayLine();
X   RelKey();
X}
X
X
SHAR_EOF
echo "extracting ins.h"
sed 's/^X//' << \SHAR_EOF > ins.h
X/* HP11 numeric limits */
X#define MAXHP11 9.999999999E99
X#define MINHP11 1E-99
X#define MAXFACT 69.95757445
X
X/* The different type of sto operations. The order must reflect the ordering of
X  instruction codes in code.h */
Xenum StoTypes {sto, add, sub, mul, div};
X
Xextern BOOL enabled, entering, overflow; /* Various flags related to the instructions */
X
X/* Current entry value, used during number entry */
Xextern BOOL expo, decpt; /* expo true for an exponent present, decpt true for decimal point */
Xextern char strx[13], expx[4];
X
Xtypedef void (*HP11Function)(void);
X
Xextern HP11Function insfunc[];
X
X/* Function declarations */
X/* ===================== */
Xdouble Check(double); /* Check the argument for HP11 limits (1e-99 --> 1e100),
X   return adjusted value if out of limits */
Xvoid DISABLE(void); /* Disable stack */
Xvoid ENABLE(void); /* Enable stack */
Xvoid Enter(void); /* Do an "Enter" */
X#define NEUTRAL() { entering = FALSE; } /* Neutral operation, simply end
X number entry */
X
X/* Instructions */
Xvoid FIX(int); /* set display mode to FIX n */
Xvoid SCI(int);
Xvoid ENG(int);
Xvoid STO(int, enum StoTypes); /* Sto in reg n (0 <= n <= 21, with 20 = I, 21 = (i)),
X with desired operation */
Xvoid RCL(int); /* RCl, n same as for sto */
Xvoid EnterNum(int); /* Add keycode to current number */
Xvoid GTO(int); /* Goto label n (n = 0 to 9, A to E (10 to 14) or I (15) : indirection */
Xvoid SF(int), CF(int), Set(int);
Xvoid GSB(int); /* Call subprogram n (cf GTO) */
Xvoid GTOLine(int); /* Jump to line in prog */
X
X#ifdef ABS
X#undef ABS
X#endif
X
Xvoid Sqrt(void), Exp(void), Exp10(void), ExpYX(void), Invert(void),
X     Divide(void), SIN(void), COS(void), TAN(void), Times(void), Rdn(void),
X     ExgXY(void), ENTER(void), Minus(void), SigmaPlus(void), Plus(void),
X     Pi(void), ToRect(void), ClearSigma(void), ClearReg(void), Random(void),
X     DoPerm(void), ToHMS(void), ToRAD(void), FRAC(void), Fact(void),
X     Estimate(void), LinearRegression(void), Sqr(void), LN(void), LOG(void),
X     Percent(void), DeltaPercent(void), ABS(void), DEG(void), RAD(void),
X     GRAD(void), ArcSIN(void), ArcCOS(void), ArcTAN(void), ToPolar(void),
X     Rup(void), CLX(void), LSTX(void), DoComb(void), ToH(void), ToDEG(void),
X     INT(void), Mean(void), SDev(void), SigmaSub(void), HypSIN(void),
X     HypCOS(void), HypTAN(void), ArcHypSIN(void), ArcHypCOS(void),
X     ArcHypTAN(void), ExgXI(void), STORandom(void), RCLSigma(void), USER(void),
X     ProgarmEntry(void), RunStart(void), XleY(void), Xlt0(void),
X     DSE(void), ISG(void), XgtY(void), Xgt0(void), PSE(void), XneY(void),
X     Xne0(void), XeqY(void), Xeq0(void), RTN(void), SST(void), BST(void),
X     HP11ColdReset(void), MEM(void), PREFIX(void), RND(void), DoCHS(void),
X     DoPoint(void), DoEEX(void), ExgXInd(void), ProgramEntry(void);
X
SHAR_EOF
echo "extracting io.c"
sed 's/^X//' << \SHAR_EOF > io.c
X#include "exec/types.h"
X
X#include "stdlib.h"
X#include "stdio.h"
X#include <math.h>
X#include "string.h"
X
X#include "hp11/hp11.h"
X#include "hp11/amiga/amiga.h"
X#include "hp11/ins.h"
X#include "hp11/io.h"
X#include "hp11/kbd.h"
X#include "hp11/codes.h"
X#include "hp11/prog_codes.h"
X
X#define MAXRUN 4 /* Length of time running is displayed */
X
X#define FOREVER for (;;)
X
Xint comma;
X
Xstatic char *stpich(char *p, int c) /* insert character c at front of string p */
X{
X   movmem(p, p + 1, strlen(p) + 1);
X   *p = c;
X
X   return(p);
X}
X
Xint GetKey() /* Read a key & wait for its release */
X{
X   int key;
X
X   key = PollKey(TRUE);
X   RelKey();
X
X   return(key);
X}
X
Xenum KeyTypes ReadKey(code) /* Read a complete key sequence, & return
X its type, intrsuction or action. */
Xregister WORD *code;
X{
X   register struct Key *curtkey;
X   register int key, offset;
X   register BOOL noKey; /* if an invalid sequence is returned, don't read a new key,
X      reuse the one which caused the error. This is set to false when that happens */
X   register enum KeyTypes ret;
X
X   noKey = TRUE; /* no key read */
X
X   FOREVER {
X      offset = 0; /* f or g not pressed */
X
X      FOREVER { /* This loop reads a key from the main, f or g shifted keyboards.
X     Further refinements (eg sto) are done algorithmically, to save space */
X     if (noKey) key = PollKey(TRUE); /* obtain next key */
X     Dispf(FALSE); Dispg(FALSE);
X     noKey = TRUE;
X     if (key == 31) { /* f pressed, toggle its status */
X        offset = (offset == NUMKEYS) ? 0 : (Dispf(TRUE), NUMKEYS);
X        RelKey();
X     }
X     else if (key == 32) { /* g */
X        offset = (offset == NUMKEYS + NUMKEYS) ? 0 : (Dispg(TRUE), NUMKEYS + NUMKEYS);
X        RelKey();
X     }
X     else break;/* got a key, exit from loop */
X      }
X      if (User && key < 5) offset ^= NUMKEYS; /* Toggle f for first five keys. This
X       doesn't affect g because the bit patterns are exclusive (42 & 84 = 0) */
X
X      Dispf(FALSE); Dispg(FALSE);
X
X      curtkey = mainKbd + offset + key; /* find address of (eventually shifted) key */
X
X      switch (curtkey->Sort) {
X     case Action:
X        *code = curtkey->Act;
X        return(Action);
X     case Instruction:
X        *code = curtkey->Code;
X        return(Instruction);
X     case Prefix: /* Key is a prefix, execute corresponding routine */
X        RelKey();
X        ret = (*(curtkey->Suffix))(code);
X        if (ret != Invalid) return(ret); /* if successful */
X
X        key = *code; /* else, invalid keycode returnedin code field for reuse */
X        noKey = FALSE; /* a key is already available */
X        break;
X     case Invalid: /* An inavlid f or g sequence was entered, retry it with
X        the f or g prefix stripped. Therefore all obtainable main keyboard sequences
X        must exist, otherwise the program enters an infinite loop retrying constantly
X        the same nonexistent keycode */
X        key %= NUMKEYS;
X        noKey = FALSE;
X        break;
X      }
X   }
X}
X
X/* Return position n on the liquid cristal display in string t */
Xint scrpos(t, n)
Xchar *t;
Xregister int n;
X{
X   register char *s = t;
X   register int pos;
X
X   pos = 0;
X   while (pos <= n && *s) { /* go on till end of string or beyond position n on display */
X      if (*s != '.' && *s != ',') pos++; /* . & , take no space on the display */
X      s++;
X   }
X   return((int)((s - t) - 1 - (pos - n))); /* pos - n  is there to take care of the overshoot. If
X   n is beyond the end of the string, the position returned may well be wildly beyond the
X   actual end of the string */
X}
X
X/* Return the length taken up on the screen by the string */
Xint scrlen(s)
Xregister char *s;
X{
X   register int cnt = 0;
X
X   while (*s) {
X      if (*s != '.' && *s != ',') cnt++; /* . & , take no space on the display */
X      s++;
X   }
X
X   return(cnt);
X}
X
X/* format string s in hp11 display format (without exponent) so that it takes
X n spaces in the display. s isn't modified */
Xstatic char *CvtStd(char *s, int n)
X{
X   static char buf[20];
X   register char *p;
X   register int i, nb;
X   register int digit_separator = comma ? '.' : ','; /* separator according to current setting */
X
X   strcpy(buf, s); /* copy string to safe work buffer */
X
X   if ((p = strchr(buf, '.')) == NULL) { /* find position of . */
X      p = buf + strlen(buf);
X      if (!entering) *p = comma ? ',' : '.';
X      *(p + 1) = '\0';
X   }
X   else if (comma) *p = ','; /* Replace . by , if necessary */
X
X   while ((p -= 3) - buf > 1) /* Add , (or .) to string every 3 digits */
X      stpich(p, digit_separator);
X
X   nb = n - scrlen(buf);
X   for (i = 1; i <= nb; i++) strcat(buf, " "); /* pad with spaces to required screen length */
X   buf[scrpos(buf, n) + 1] = '\0'; /* cut at n characters */
X
X   return(buf);
X}
X
X/* format string s in hp11 display format (with exponent) */
Xstatic char *CvtExpo(char *s, char *e)
X{
X   if (strlen(e) > 3) { /* deal with roundoff towards 1e100 when nb too big */
X      e = " 99"; /* exponent is 99 */
X      strncpy(s + 1, "9.999999999", strlen(s + 1)); /* mantissa is enough 9's */
X   }
X
X   return(strcat(CvtStd(s, 8), e));
X}
X
X/* convert x to scientific format with n digits. Returns it in a static buffer (from CvtStd) */
Xstatic char *Scient(double x, int n)
X{
X   char buf[20];
X   register char *pe;
X
X   sprintf(buf, "% .*E", n, x); /* Scientific format with n digits */
X   pe = strchr(buf, 'E'); /* split string into mantissa & exponent */
X   *pe++ = '\0';
X   /* if (*pe == '+') *pe = ' '; A + is displayed as a space by the Display routine anyway */
X
X   return(CvtExpo(buf, pe));
X}
X
X/* Convert x to fix n format */
Xstatic char *Fixed(double x, int n)
X{
X   char buf[80];
X
X   sprintf(buf, "% .*f", n, x);
X
X   return(CvtStd(buf, 11));
X}
X
X/* Eng n format */
Xstatic char *Engin(double x, int n)
X{
X   char expbuf[10], buf[80];
X   register char *pe;
X   double mantissa;
X   register int exponent, dif;
X
X   sprintf(buf, "%.*E", n, x); /* print enough digits */
X   *(pe = strchr(buf, 'E')) = '\0';
X   mantissa = atof(buf); /* get mantissa & exponent */
X   exponent = atoi(pe + 1);
X
X   /* Round exponent down to a multiple of 3 */
X   dif = exponent % 3;
X   if (dif < 0) dif += 3;
X   exponent -= dif; /* calculate new exponent & mantissa */
X   mantissa *= pow(10.0, (double)dif);
X
X   /* Convert them to string */
X   sprintf(buf, "% .*f", (n - dif > 0) ? n - dif : 0, mantissa);
X   sprintf(expbuf, "%c%02d", (exponent < 0) ? '-' : ' ', iabs(exponent)); /* pad exponent with 0's, hence %02d not %2d */
X
X   return(CvtExpo(buf, expbuf));
X}
X
X/* Display current trig mode */
Xstatic void DispAngle(void)
X{
X   switch (Angles) {
X      case grad:DispG(TRUE);
X      case rad:DispRAD(TRUE);
X      case deg:break;
X   }
X}
X
X/* Display current x value in normal mode, running in run mode */
Xvoid Disp()
X{
X   static int runcnt = MAXRUN;
X   static BOOL runon;
X
X   if (running) { /* Flash running on and off every MAXRUN calls */
X      if (fast) { /* Display Running only once in fast mode */
X     if (!runon) {
X        Display("  Running");
X        runon = TRUE; /* Running displayed */
X     }
X      }
X      else if (runcnt-- == 0) Display("");
X      else if (runcnt <= -MAXRUN) {
X     runcnt = MAXRUN;
X     Display("  Running");
X      }
X   }
X   else {
X      runon = FALSE; /* Running not displayed */
X      if (entering) /* Display number entry strings */
X     if (expo) Display(CvtExpo(strx, expx)); /* with exponent */
X     else Display(CvtStd(strx, 11));
X      else
X     Display(NbStr(X));
X
X      DispAngle();
X      if (User) DispUSER(TRUE);
X   }
X}
X
Xchar *NbStr(x)
Xdouble x;
X{
X   switch (Mode) { /* Display x according to display mode */
X      case fix:if ((fabs(X) >= minfix / 2.0 || X == 0.0) && fabs(X) < 1E10) {
X          /* Number can be displayed in fix mode */
X          return(Fixed(X, Digits));
X           }
X           /* fall through for call to Scient */
X      case sci:return(Scient(X, Digits));
X      case eng:return(Engin(X, Digits));
X   }
X}
X
X/* Display Error n, & wait for a key to be pressed */
Xvoid Error(n)
Xint n;
X{
X   register char *buf;
X
X   entering = FALSE; /* end of digit entry */
X   error = TRUE; /* an error has occured */
X   buf = "  Error  ";
X   buf[8] = n; buf[9] ='\0';
X
X   if (!running) RelKey();
X   Display(buf);
X   GetKey();
X
X}
X
X/* Display current program line */
Xvoid DisplayLine()
X{
X   register int c1 = keycodes[Prog[PC]].c1, c2 = keycodes[Prog[PC]].c2,
X        c3 = keycodes[Prog[PC]].c3;
X   char _buf[20], _insbuf[20];
X   register char *buf = _buf, *insbuf = _insbuf;
X   register int point = comma ? ',' : '.'; /* separator according to current setting */
X
X   sprintf(buf, " %03d-", PC); /* prepare program line */
X
X   /* Prepare instruction buffer */
X   if (PC == 0) insbuf[0] = '\0'; /* nothing at line 0 */
X   else switch (keycodes[Prog[PC]].Type) { /* there are 6 methods for displaying a line */
X      case ONECODE: sprintf(insbuf, "%6d", c1); break; /*     nn eg SIN or 9 */
X      case TWOCODE: sprintf(insbuf, "%3d%3d", c1, c2); break; /*  nn nn eg g LOG */
X      case TWOCODE_9: sprintf(insbuf, "%4d%2d", c1, c2); break; /*  nn n eg STO 5*/
X      case TWOCODE_PT: sprintf(insbuf, "%4d %c%1d", c1, point, c2); break; /* nn .n eg RCL .6 */
X      case THREECODE: sprintf(insbuf, "%2d,%2d,%2d", c1, c2, c3); break; /* nn,nn,nn eg f HYP SIN */
X      case THREECODE_PT: sprintf(insbuf, "%2d,%2d, %c%1d", c1, c2, point, c3); break; /* nn,nn, .n eg STO + .0 */
X   }
X
X   Display(strcat(buf, insbuf));
X
X   DispAngle();
X   if (User) DispUSER(TRUE);
X}
X
SHAR_EOF
echo "extracting io.h"
sed 's/^X//' << \SHAR_EOF > io.h
Xextern int comma; /* The current comma setting : true if decimal point is a comma,
X false if it is a point */
X
Xenum KeyTypes ReadKey(WORD *); /* Read a complete key sequence */
Xvoid Disp(void); /* Display the current value of X register */
Xvoid Error(int); /* Display Error n */
Xint GetKey(void); /* Read a key from the HP11 (waiting for its release) */
Xint scrpos(char *, int); /* Return position n on the liquid cristal display in string t */
Xint scrlen(char *); /* Return the length taken up on the screen by the string */
Xvoid DisplayLine(void); /* Display current program line */
Xchar *NbStr(double); /* Convert number into string according to current mode */
SHAR_EOF
echo "extracting kbd.c"
sed 's/^X//' << \SHAR_EOF > kbd.c
X#include "exec/types.h"
X#include "hp11/hp11.h"
X#include "hp11/kbd.h"
X#include "hp11/codes.h"
X#include "hp11/io.h"
X
X/* Macros to initialise one field of the keyboard structure to a particular type.
X  This simpilfies (& clarifies) this initialisation. */
X#define CODE(code) {Instruction, (Decoder)(code) }
X#define ACT(act) {Action, (Decoder)(act) }
X#define PREFIX(adr) {Prefix, (adr) }
X#define INVALID() {Invalid, NULL }
X
X/* Often used macros which return their agument signaling that it is an instruction,
X  action or error */
X#define RETINS(val) { *code = (val); return(Instruction); }
X#define RETACT(val) { *code = (val); return(Action); }
X#define RETERR(key) { *code = (key); return(Invalid); }
X
X/* Keys which can follow GTO (or GSB). A -1 indicates am invalid sequence, otherwise
X  the value is the offset to add to KGTO to obtain the corresponding instruction.
X  IGTO_LINE is different and valid only for GTO, it indicates a GTO .nnn action */
Xstatic BYTE gto_decode[NUMKEYS] = {
X   10, 11, 12, 13, 14, -1, 7, 8, 9, -1,
X   -1, -1, -1, -1, OIND_G, -1, 4, 5, 6, -1,
X   -1, -1, -1, -1, -1, -1, 1, 2, 3, -1,
X   -1, -1, -1, -1, -1, -1, 0, IGTO_LINE, -1, -1,
X   -1, -1
X};
X
X/* For STO & RCL, cf above */
Xstatic BYTE sto_decode[NUMKEYS] = {
X   -1, -1, -1, -1, -1, -1, 7, 8, 9, ODIV,
X   -1, -1, -1, OIND_R, OI, -1, 4, 5, 6, OMUL,
X   -1, -1, -1, -1, -1, KRANDOM, 1, 2, 3, OSUB,
X   -1, -1, -1, -1, -1, -1, 0, KPOINT, KSIGMA_PLUS, OPLUS,
X   -1, -1
X};
X
X/* Functions which take a numeric argument only (eg eng) can use the numbers
X  from gto_decode, considering as invalid what isn't a number between 1 & 10 */
X#define nb_decode gto_decode
X
X/* Read 3 digits for GTO .nnn & return the value in line. If something other than
X  a number is entered, return the keycode of the first incorrect code & FALSE */
Xstatic BOOL GetLine(short *line)
X{
X   register int cnt = 0, key;
X   register int dec;
X
X   *line = 0;
X
X   do {
X      key = GetKey(); dec = nb_decode[key]; /* Get numeric value */
X      if (dec >= 0 && dec <= 9) { /* It is a digit */
X     cnt++;
X     *line = *line * 10 + dec;
X      }
X      else { /* error */
X     *line = key;
X     return(FALSE);
X      }
X   } while (cnt < 3);
X
X   /* 3 digits reads */
X   return(TRUE);
X}
X
X/* Decoder routine for FIX, SCI, ENG, SF, CF, Set. code returns the
X  instruction/action/keycode, start is the offset for the instruction being
X  decoded (eg KFIX), max is the maximum value which can be accepted (eg 1 for SF).
X  For SCI & ENG, a number beyond their max (7) is treated as if it was the max
X  value (So if you type 'f SCI 8' you will get 'f SCI 7' */
Xstatic enum KeyTypes NBDec(short *code, int start, int max)
X{
X   register int key, dec;
X
X   key = GetKey(); dec = nb_decode[key];
X
X   if (dec >= 0 && dec <= 9) { /* Is a digit */
X      if (dec <= max) RETINS(start + dec) /* valid ins */
X      else if (start == KSCI || start == KENG) RETINS(start + max)
X     /* Special treatment for SCI & ENG */
X   }
X   RETERR(key);
X}
X
X/* Decoding for HYP & ArcHYP */
Xstatic enum KeyTypes HypDec(short *code, int start)
X{
X   int key;
X
X   key = GetKey();
X   if (key >= 12 /* SIN */ && key <= 14 /* TAN */) RETINS(start + key - 12)
X   else RETERR(key);
X}
X
X/* Decoding for GTO, GSB & LBL */
Xstatic enum KeyTypes JMPDec(short *code, int start)
X{
X   register int key, dec;
X   short val;
X
X   key = GetKey(); dec = gto_decode[key];
X
X   if (dec >= 0 && dec <= 15) RETINS(start + dec); /* 0 to 9, A to E */
X   switch (dec) {
X      case IGTO_LINE: if (start == KGTO) /* GTO .nnn */
X     if (GetLine(&val)) RETACT(IGTO_LINE + val)
X     else RETERR(val);
X      case OIND_G: if (start != KLBL) RETINS(start + OIND_G); /* GTO/GSB I */
X   }
X   RETERR(key);
X}
X
X/* Decoding for STO & RCL, deals with all possible STO's */
Xstatic enum KeyTypes REGDec(short *code, int start)
X{
X   register int dec, key, oldoff, offset = 0;
X
X   do {
X      key = GetKey();
X      dec = sto_decode[key];
X      oldoff = offset;
X
X      if ((dec >= 0 && dec <= 9) /* 0 to 9 end an instruction */
X      || /* I & (i) end an instruction if no . was typed before. This
X           is visible if the offset (ignoring + - * /) is 10 */
X      ((offset % OPLUS) != 10 && (dec == OI || dec == OIND_R)))
X     RETINS(start + offset + dec);
X      switch (dec) { /* Special cases & offsets */
X     case KRANDOM: if (offset == 0 && start == KSTO) RETINS(KSTO_RANDOM); /* STO Random */
X     case KSIGMA_PLUS: if (offset == 0 && start == KRCL) RETINS(KRCL_SIGMA); /* Recall stats */
X     case KPOINT: if ((offset % OPLUS) == 0) offset += 10; /* Only one . allowed */
X     case OPLUS: case ODIV: case OMUL: case OSUB: /* + - * / only if none yet */
X        if (offset == 0 && start == KSTO) offset = dec;
X      }
X   } while (offset != oldoff);
X   /* if offset not changed then there was an error (the loop is repeated when
X      the offset changes) */
X   RETERR(key);
X}
X
X/* Decoding for prefixes */
X/* --------------------- */
Xstatic enum KeyTypes FIXDec(short *code)
X{
X   return(NBDec(code, KFIX, 9));
X}
X
Xstatic enum KeyTypes SCIDec(short *code)
X{
X   return(NBDec(code, KSCI, 7));
X}
X
Xstatic enum KeyTypes ENGDec(short *code)
X{
X   return(NBDec(code, KENG, 7));
X}
X
Xstatic enum KeyTypes SFDec(short *code)
X{
X   return(NBDec(code, KFLAGS + OSF, 1));
X}
X
Xstatic enum KeyTypes SETDec(short *code)
X{
X   return(NBDec(code, KFLAGS + OSET, 1));
X}
X
Xstatic enum KeyTypes CFDec(short *code)
X{
X   return(NBDec(code, KFLAGS + OCF, 1));
X}
X
Xstatic enum KeyTypes HYPDec(short *code)
X{
X   return(HypDec(code, KHYP));
X}
X
Xstatic enum KeyTypes ARCHYPDec(short *code)
X{
X   return(HypDec(code, KARCHYP));
X}
X
Xstatic enum KeyTypes LBLDec(short *code)
X{
X   return(JMPDec(code, KLBL));
X}
X
Xstatic enum KeyTypes GTODec(short *code)
X{
X   return(JMPDec(code, KGTO));
X}
X
Xstatic enum KeyTypes GSBDec(short *code)
X{
X   return(JMPDec(code, KGSB));
X}
X
Xstatic enum KeyTypes STODec(short *code)
X{
X   return(REGDec(code, KSTO));
X}
X
Xstatic enum KeyTypes RCLDec(short *code)
X{
X   return(REGDec(code, KRCL));
X}
X
X/* The main kbd, f & g */
X/* ------------------- */
Xstruct Key mainKbd[3 * NUMKEYS] = {
X/* First the main keyboard (unshifted). All the keys which can be entered
X  MUST not be INVALID(), otherwise the program enters an infinite loop */
X   CODE(KSQRT),
X   CODE(KEXP),
X   CODE(KEXP10),
X   CODE(KEXP_YX),
X   CODE(KINV),
X   CODE(KCHS),
X   CODE(KFIG + 7),
X   CODE(KFIG + 8),
X   CODE(KFIG + 9),
X   CODE(KDIV),
X   ACT(ISST),
X   PREFIX(GTODec),
X   CODE(KTRIG + OSIN),
X   CODE(KTRIG + OCOS),
X   CODE(KTRIG + OTAN),
X   CODE(KEEX),
X   CODE(KFIG + 4),
X   CODE(KFIG + 5),
X   CODE(KFIG + 6),
X   CODE(KMUL),
X   CODE(KR_S),
X   PREFIX(GSBDec),
X   CODE(KRDN),
X   CODE(KEXG_XY),
X   ACT(IBACK),
X   CODE(KENTER),
X   CODE(KFIG + 1),
X   CODE(KFIG + 2),
X   CODE(KFIG + 3),
X   CODE(KSUB),
X   ACT(ION),
X   INVALID(), /* Never tested : f */
X   INVALID(), /* Never tested : g */
X   PREFIX(STODec),
X   PREFIX(RCLDec),
X   INVALID(), /* This key does not exist : it is hidden by ENTER */
X   CODE(KFIG + 0),
X   CODE(KPOINT),
X   CODE(KSIGMA_PLUS),
X   CODE(KPLUS),
X   ACT(IRESET), /* These 2 are pseudo-keys */
X   ACT(IDISPLAY),
X/* now f codes, which can be INVALID() */
X   CODE(KGSB + OA),
X   CODE(KGSB + OB),
X   CODE(KGSB + OC),
X   CODE(KGSB + OD),
X   CODE(KGSB + OE),
X   CODE(KPI),
X   PREFIX(FIXDec),
X   PREFIX(SCIDec),
X   PREFIX(ENGDec),
X   CODE(KX_LE_Y),
X   PREFIX(LBLDec),
X   PREFIX(HYPDec),
X   CODE(KEXG_X_IND),
X   CODE(KRCL + OIND_R),
X   CODE(KRCL + OI),
X   CODE(KRECT),
X   CODE(KEXG_XI),
X   CODE(KDSE),
X   CODE(KISG),
X   CODE(KX_GT_Y),
X   CODE(KPSE),
X   CODE(KCLR_SIGMA),
X   ACT(ICLR_PRGM),
X   CODE(KCLR_REG),
X   ACT(ICLR_PREFIX),
X   CODE(KRANDOM),
X   CODE(KPERM),
X   CODE(KHMS),
X   CODE(KTO_RAD),
X   CODE(KX_NE_Y),
X   INVALID(), INVALID(), INVALID(), /* ON, f & g */
X   CODE(KFRAC),
X   ACT(IUSER),
X   INVALID(), /* dosen't exist */
X   CODE(KFACT),
X   CODE(KESTIMATE),
X   CODE(KLR),
X   CODE(KX_EQ_Y),
X   INVALID(), INVALID(),
X/* finally, g codes */
X   CODE(KSQR),
X   CODE(KLN),
X   CODE(KLOG),
X   CODE(KPERC),
X   CODE(KDELTA_PERC),
X   CODE(KABS),
X   CODE(KDEG),
X   CODE(KRAD),
X   CODE(KGRD),
X   CODE(KX_LT_0),
X   ACT(IBST),
X   PREFIX(ARCHYPDec),
X   CODE(KARC + OSIN),
X   CODE(KARC + OCOS),
X   CODE(KARC + OTAN),
X   CODE(KPOLAR),
X   PREFIX(SFDec),
X   PREFIX(CFDec),
X   PREFIX(SETDec),
X   CODE(KX_GT_0),
X   ACT(IP_R),
X   CODE(KRTN),
X   CODE(KRUP),
X   CODE(KRND),
X   CODE(KCLX),
X   CODE(KLSTX),
X   CODE(KCOMB),
X   CODE(KHR),
X   CODE(KTO_DEG),
X   CODE(KX_NE_0),
X   INVALID(), INVALID(), INVALID(),
X   CODE(KINT),
X   ACT(IMEM),
X   INVALID(),
X   CODE(KMEAN),
X   CODE(KSDEV),
X   CODE(KSIGMA_SUB),
X   CODE(KX_EQ_0),
X   INVALID(), INVALID()
X};
X
SHAR_EOF
echo "extracting kbd.h"
sed 's/^X//' << \SHAR_EOF > kbd.h
X/* Define type Decoder which is a function with a short * argument and which
X  return an enum KeyTypes. These functions do the keyboard decoding for prefixes */
Xtypedef enum KeyTypes (*Decoder)(short *);
X
X/* One key of the keyboard structure : */
Xstruct Key {
X   enum KeyTypes Sort; /* The type of key */
X   union { /* Different data for each type */
X      Decoder suffix; /* Prefix ==> decoder function */
X      LONG act; /* Action number */
X      LONG code; /* Instruction number */
X   } Data;
X};
X
X/* These defines are done to simplify access to the components */
X#define Act Data.act
X#define Code Data.code
X#define Suffix Data.suffix
X
Xextern struct Key mainKbd[3 * NUMKEYS]; /* The main, f & g key sequences */
SHAR_EOF
echo "extracting lmkdebug"
sed 's/^X//' << \SHAR_EOF > lmkdebug
XFLAGS = -v -cf -rr -ilcc: -d5
XFLAGS2 = -Hinclude:small.sym $(FLAGS)
XOBJ = od/
X
X.c.o:
X  lc $(FLAGS) -o$(OBJ) $*
X
Xhp11: $(OBJ)hp11.o $(OBJ)io.o $(OBJ)ins.o $(OBJ)kbd.o $(OBJ)prog_codes.o \
X      $(OBJ)support.o $(OBJ)indic.o $(OBJ)chip.o $(OBJ)menus.o $(OBJ)icon.o \
X      $(OBJ)amiga.o $(OBJ)chars.o
X    blink with hp11.debug
X
X$(OBJ)hp11.o: hp11.c hp11.h amiga/amiga.h io.h support.h ins.h codes.h
X
X$(OBJ)io.o: io.c hp11.h amiga/amiga.h ins.h io.h kbd.h codes.h prog_codes.h
X
X$(OBJ)ins.o: ins.c amiga/amiga.h hp11.h io.h support.h ins.h codes.h
X
X$(OBJ)kbd.o: kbd.c hp11.h kbd.h codes.h io.h
X
X$(OBJ)prog_codes.o: prog_codes.c prog_codes.h
X
X$(OBJ)support.o: support.c support.h
X
X$(OBJ)chars.o: amiga/chars.c
X  lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)indic.o: amiga/indic.c
X  lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)chip.o: amiga/chip.c
X  lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)menus.o: amiga/menus.c hp11.h io.h ins.h amiga/menus.h amiga/internal.h amiga/cbio.h
X  lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)icon.o: amiga/icon.c
X# Should be same as other amiga routines, but there is a bug ...
X
X$(OBJ)amiga.o: amiga/amiga.c hp11.h amiga/internal.h amiga/amiga.h amiga/menus.h
X  lc $(FLAGS2) -o$(OBJ) $*
X
SHAR_EOF
echo "extracting lmkfile"
sed 's/^X//' << \SHAR_EOF > lmkfile
XFLAGS = -v -cf -m1s -O -ilcc: -rr
XFLAGS2 = $(FLAGS)
XOBJ = o/
X
X.c.o:
X  lc $(FLAGS) -o$(OBJ) $*
X
Xhp11: $(OBJ)hp11.o $(OBJ)io.o $(OBJ)ins.o $(OBJ)kbd.o $(OBJ)prog_codes.o \
X      $(OBJ)support.o $(OBJ)indic.o $(OBJ)chip.o $(OBJ)menus.o $(OBJ)icon.o \
X      $(OBJ)amiga.o $(OBJ)chars.o
X    blink with hp11.lnk
X
X$(OBJ)hp11.o: hp11.c hp11.h amiga/amiga.h io.h support.h ins.h codes.h
X
X$(OBJ)io.o: io.c hp11.h amiga/amiga.h ins.h io.h kbd.h codes.h prog_codes.h
X
X$(OBJ)ins.o: ins.c amiga/amiga.h hp11.h io.h support.h ins.h codes.h
X
X$(OBJ)kbd.o: kbd.c hp11.h kbd.h codes.h io.h
X
X$(OBJ)prog_codes.o: prog_codes.c prog_codes.h
X
X$(OBJ)support.o: support.c support.h
X
X$(OBJ)chars.o: amiga/chars.c
X  lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)indic.o: amiga/indic.c
X  lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)chip.o: amiga/chip.c
X  lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)menus.o: amiga/menus.c hp11.h io.h ins.h amiga/menus.h amiga/internal.h amiga/cbio.h
X  lc $(FLAGS2) -o$(OBJ) $*
X
X$(OBJ)icon.o: amiga/icon.c
X# Should be same as other amiga routines, but there is a bug ...
X
X$(OBJ)amiga.o: amiga/amiga.c hp11.h amiga/internal.h amiga/amiga.h amiga/menus.h
X  lc $(FLAGS2) -o$(OBJ) $*
X
SHAR_EOF
if `test ! -d o`
then
  mkdir o
  echo "mkdir o"
fi
echo "extracting o/dummy"
sed 's/^X//' << \SHAR_EOF > o/dummy
SHAR_EOF
if `test ! -d od`
then
  mkdir od
  echo "mkdir od"
fi
echo "extracting od/dummy"
sed 's/^X//' << \SHAR_EOF > od/dummy
SHAR_EOF
echo "extracting prog_codes.c"
sed 's/^X//' << \SHAR_EOF > prog_codes.c
X/* The actual codes used */
X#include "exec/types.h"
X
X#include "hp11/prog_codes.h"
X
X/* To decode an instruction, you use its code (from codes.h). Therefore,
X  if these are changed, you must change these keycodes as well */
Xstruct KeyCode keycodes[] = {
X   {ONECODE, 11},
X   {ONECODE, 12},
X   {ONECODE, 13},
X   {ONECODE, 14},
X   {ONECODE, 15},
X   {ONECODE, 16},
X   {ONECODE, 10},
X   {ONECODE, 23},
X   {ONECODE, 24},
X   {ONECODE, 25},
X   {ONECODE, 26},
X   {ONECODE, 20},
X   {ONECODE, 31},
X   {ONECODE, 33},
X   {ONECODE, 34},
X   {ONECODE, 36},
X   {ONECODE, 30},
X   {ONECODE, 48},
X   {ONECODE, 49},
X   {ONECODE, 40},
X/* f codes */
X   {TWOCODE, 42, 16},
X   {TWOCODE, 42, 10},
X   {TWOCODE, 42, 23},
X   {TWOCODE, 42, 26},
X   {TWOCODE_9, 42, 4},
X   {TWOCODE_9, 42, 5},
X   {TWOCODE_9, 42, 6},
X   {TWOCODE, 42, 20},
X   {TWOCODE, 42, 31},
X   {TWOCODE, 42, 32},
X   {TWOCODE, 42, 34},
X   {TWOCODE, 42, 36},
X   {TWOCODE_9, 42, 1},
X   {TWOCODE_9, 42, 2},
X   {TWOCODE_9, 42, 3},
X   {TWOCODE, 42, 30},
X   {TWOCODE, 42, 44},
X   {TWOCODE_9, 42,0},
X   {TWOCODE, 42, 48},
X   {TWOCODE, 42, 49},
X   {TWOCODE, 42, 40},
X/* g codes */
X   {TWOCODE, 43, 11},
X   {TWOCODE, 43, 12},
X   {TWOCODE, 43, 13},
X   {TWOCODE, 43, 14},
X   {TWOCODE, 43, 15},
X   {TWOCODE, 43, 16},
X   {TWOCODE_9, 43, 7},
X   {TWOCODE_9, 43, 8},
X   {TWOCODE_9, 43, 9},
X   {TWOCODE, 43, 10},
X   {TWOCODE, 43, 23},
X   {TWOCODE, 43, 24},
X   {TWOCODE, 43, 25},
X   {TWOCODE, 43, 26},
X   {TWOCODE, 43, 20},
X   {TWOCODE, 43, 32},
X   {TWOCODE, 43, 33},
X   {TWOCODE, 43, 34},
X   {TWOCODE, 43, 35},
X   {TWOCODE, 43, 36},
X   {TWOCODE_9, 43, 1},
X   {TWOCODE_9, 43, 2},
X   {TWOCODE_9, 43, 3},
X   {TWOCODE, 43, 30},
X   {TWOCODE, 43, 44},
X   {TWOCODE_9, 43, 0},
X   {TWOCODE, 43, 48},
X   {TWOCODE, 43, 49},
X   {TWOCODE, 43, 40},
X/* Miscellaneous */
X   {TWOCODE, 45, 36},
X   {TWOCODE, 45, 49},
X/* ARC */
X   {THREECODE, 42, 22, 23},
X   {THREECODE, 42, 22, 24},
X   {THREECODE, 42, 22, 25},
X   {THREECODE, 43, 22, 23},
X   {THREECODE, 43, 22, 24},
X   {THREECODE, 43, 22, 25},
X/* Flags */
X   {THREECODE, 43, 4, 0},
X   {THREECODE, 43, 4, 1},
X   {THREECODE, 43, 5, 0},
X   {THREECODE, 43, 5, 1},
X   {THREECODE, 43, 6, 0},
X   {THREECODE, 43, 6, 1},
X/* Figures */
X   {ONECODE, 0},
X   {ONECODE, 1},
X   {ONECODE, 2},
X   {ONECODE, 3},
X   {ONECODE, 4},
X   {ONECODE, 5},
X   {ONECODE, 6},
X   {ONECODE, 7},
X   {ONECODE, 8},
X   {ONECODE, 9},
X/* FIX, SCI, ENG */
X   {THREECODE, 42, 7, 0},
X   {THREECODE, 42, 7, 1},
X   {THREECODE, 42, 7, 2},
X   {THREECODE, 42, 7, 3},
X   {THREECODE, 42, 7, 4},
X   {THREECODE, 42, 7, 5},
X   {THREECODE, 42, 7, 6},
X   {THREECODE, 42, 7, 7},
X   {THREECODE, 42, 7, 8},
X   {THREECODE, 42, 7, 9},
X
X   {THREECODE, 42, 8, 0},
X   {THREECODE, 42, 8, 1},
X   {THREECODE, 42, 8, 2},
X   {THREECODE, 42, 8, 3},
X   {THREECODE, 42, 8, 4},
X   {THREECODE, 42, 8, 5},
X   {THREECODE, 42, 8, 6},
X   {THREECODE, 42, 8, 7},
X
X   {THREECODE, 42, 9, 0},
X   {THREECODE, 42, 9, 1},
X   {THREECODE, 42, 9, 2},
X   {THREECODE, 42, 9, 3},
X   {THREECODE, 42, 9, 4},
X   {THREECODE, 42, 9, 5},
X   {THREECODE, 42, 9, 6},
X   {THREECODE, 42, 9, 7},
X/* LBL, GTO, GSB */
X   {THREECODE, 42, 21, 0},
X   {THREECODE, 42, 21, 1},
X   {THREECODE, 42, 21, 2},
X   {THREECODE, 42, 21, 3},
X   {THREECODE, 42, 21, 4},
X   {THREECODE, 42, 21, 5},
X   {THREECODE, 42, 21, 6},
X   {THREECODE, 42, 21, 7},
X   {THREECODE, 42, 21, 8},
X   {THREECODE, 42, 21, 9},
X   {THREECODE, 42, 21, 11},
X   {THREECODE, 42, 21, 12},
X   {THREECODE, 42, 21, 13},
X   {THREECODE, 42, 21, 14},
X   {THREECODE, 42, 21, 15},
X
X   {TWOCODE_9, 22, 0},
X   {TWOCODE_9, 22, 1},
X   {TWOCODE_9, 22, 2},
X   {TWOCODE_9, 22, 3},
X   {TWOCODE_9, 22, 4},
X   {TWOCODE_9, 22, 5},
X   {TWOCODE_9, 22, 6},
X   {TWOCODE_9, 22, 7},
X   {TWOCODE_9, 22, 8},
X   {TWOCODE_9, 22, 9},
X   {TWOCODE, 22, 11},
X   {TWOCODE, 22, 12},
X   {TWOCODE, 22, 13},
X   {TWOCODE, 22, 14},
X   {TWOCODE, 22, 15},
X   {TWOCODE, 22, 25},
X
X   {TWOCODE_9, 32, 0},
X   {TWOCODE_9, 32, 1},
X   {TWOCODE_9, 32, 2},
X   {TWOCODE_9, 32, 3},
X   {TWOCODE_9, 32, 4},
X   {TWOCODE_9, 32, 5},
X   {TWOCODE_9, 32, 6},
X   {TWOCODE_9, 32, 7},
X   {TWOCODE_9, 32, 8},
X   {TWOCODE_9, 32, 9},
X   {TWOCODE, 32, 11},
X   {TWOCODE, 32, 12},
X   {TWOCODE, 32, 13},
X   {TWOCODE, 32, 14},
X   {TWOCODE, 32, 15},
X   {TWOCODE, 32, 25},
X/* STO, STO +, STO -, STO *, STO / */
X   {TWOCODE_9, 44, 0},
X   {TWOCODE_9, 44, 1},
X   {TWOCODE_9, 44, 2},
X   {TWOCODE_9, 44, 3},
X   {TWOCODE_9, 44, 4},
X   {TWOCODE_9, 44, 5},
X   {TWOCODE_9, 44, 6},
X   {TWOCODE_9, 44, 7},
X   {TWOCODE_9, 44, 8},
X   {TWOCODE_9, 44, 9},
X   {TWOCODE_PT, 44, 0},
X   {TWOCODE_PT, 44, 1},
X   {TWOCODE_PT, 44, 2},
X   {TWOCODE_PT, 44, 3},
X   {TWOCODE_PT, 44, 4},
X   {TWOCODE_PT, 44, 5},
X   {TWOCODE_PT, 44, 6},
X   {TWOCODE_PT, 44, 7},
X   {TWOCODE_PT, 44, 8},
X   {TWOCODE_PT, 44, 9},
X   {TWOCODE, 44, 25},
X   {TWOCODE, 44, 24},
X
X   {THREECODE, 44, 40, 0},
X   {THREECODE, 44, 40, 1},
X   {THREECODE, 44, 40, 2},
X   {THREECODE, 44, 40, 3},
X   {THREECODE, 44, 40, 4},
X   {THREECODE, 44, 40, 5},
X   {THREECODE, 44, 40, 6},
X   {THREECODE, 44, 40, 7},
X   {THREECODE, 44, 40, 8},
X   {THREECODE, 44, 40, 9},
X   {THREECODE_PT, 44, 40, 0},
X   {THREECODE_PT, 44, 40, 1},
X   {THREECODE_PT, 44, 40, 2},
X   {THREECODE_PT, 44, 40, 3},
X   {THREECODE_PT, 44, 40, 4},
X   {THREECODE_PT, 44, 40, 5},
X   {THREECODE_PT, 44, 40, 6},
X   {THREECODE_PT, 44, 40, 7},
X   {THREECODE_PT, 44, 40, 8},
X   {THREECODE_PT, 44, 40, 9},
X   {THREECODE, 44, 40, 25},
X   {THREECODE, 44, 40, 24},
X
X   {THREECODE, 44, 30, 0},
X   {THREECODE, 44, 30, 1},
X   {THREECODE, 44, 30, 2},
X   {THREECODE, 44, 30, 3},
X   {THREECODE, 44, 30, 4},
X   {THREECODE, 44, 30, 5},
X   {THREECODE, 44, 30, 6},
X   {THREECODE, 44, 30, 7},
X   {THREECODE, 44, 30, 8},
X   {THREECODE, 44, 30, 9},
X   {THREECODE_PT, 44, 30, 0},
X   {THREECODE_PT, 44, 30, 1},
X   {THREECODE_PT, 44, 30, 2},
X   {THREECODE_PT, 44, 30, 3},
X   {THREECODE_PT, 44, 30, 4},
X   {THREECODE_PT, 44, 30, 5},
X   {THREECODE_PT, 44, 30, 6},
X   {THREECODE_PT, 44, 30, 7},
X   {THREECODE_PT, 44, 30, 8},
X   {THREECODE_PT, 44, 30, 9},
X   {THREECODE, 44, 30, 25},
X   {THREECODE, 44, 30, 24},
X
X   {THREECODE, 44, 20, 0},
X   {THREECODE, 44, 20, 1},
X   {THREECODE, 44, 20, 2},
X   {THREECODE, 44, 20, 3},
X   {THREECODE, 44, 20, 4},
X   {THREECODE, 44, 20, 5},
X   {THREECODE, 44, 20, 6},
X   {THREECODE, 44, 20, 7},
X   {THREECODE, 44, 20, 8},
X   {THREECODE, 44, 20, 9},
X   {THREECODE_PT, 44, 20, 0},
X   {THREECODE_PT, 44, 20, 1},
X   {THREECODE_PT, 44, 20, 2},
X   {THREECODE_PT, 44, 20, 3},
X   {THREECODE_PT, 44, 20, 4},
X   {THREECODE_PT, 44, 20, 5},
X   {THREECODE_PT, 44, 20, 6},
X   {THREECODE_PT, 44, 20, 7},
X   {THREECODE_PT, 44, 20, 8},
X   {THREECODE_PT, 44, 20, 9},
X   {THREECODE, 44, 20, 25},
X   {THREECODE, 44, 20, 24},
X
X   {THREECODE, 44, 10, 0},
X   {THREECODE, 44, 10, 1},
X   {THREECODE, 44, 10, 2},
X   {THREECODE, 44, 10, 3},
X   {THREECODE, 44, 10, 4},
X   {THREECODE, 44, 10, 5},
X   {THREECODE, 44, 10, 6},
X   {THREECODE, 44, 10, 7},
X   {THREECODE, 44, 10, 8},
X   {THREECODE, 44, 10, 9},
X   {THREECODE_PT, 44, 10, 0},
X   {THREECODE_PT, 44, 10, 1},
X   {THREECODE_PT, 44, 10, 2},
X   {THREECODE_PT, 44, 10, 3},
X   {THREECODE_PT, 44, 10, 4},
X   {THREECODE_PT, 44, 10, 5},
X   {THREECODE_PT, 44, 10, 6},
X   {THREECODE_PT, 44, 10, 7},
X   {THREECODE_PT, 44, 10, 8},
X   {THREECODE_PT, 44, 10, 9},
X   {THREECODE, 44, 10, 25},
X   {THREECODE, 44, 10, 24},
X
X/* RCL */
X   {TWOCODE_9, 45, 0},
X   {TWOCODE_9, 45, 1},
X   {TWOCODE_9, 45, 2},
X   {TWOCODE_9, 45, 3},
X   {TWOCODE_9, 45, 4},
X   {TWOCODE_9, 45, 5},
X   {TWOCODE_9, 45, 6},
X   {TWOCODE_9, 45, 7},
X   {TWOCODE_9, 45, 8},
X   {TWOCODE_9, 45, 9},
X   {TWOCODE_PT, 45, 0},
X   {TWOCODE_PT, 45, 1},
X   {TWOCODE_PT, 45, 2},
X   {TWOCODE_PT, 45, 3},
X   {TWOCODE_PT, 45, 4},
X   {TWOCODE_PT, 45, 5},
X   {TWOCODE_PT, 45, 6},
X   {TWOCODE_PT, 45, 7},
X   {TWOCODE_PT, 45, 8},
X   {TWOCODE_PT, 45, 9},
X   {TWOCODE, 45, 25},
X   {TWOCODE, 45, 24},
X};
SHAR_EOF
echo "extracting prog_codes.h"
sed 's/^X//' << \SHAR_EOF > prog_codes.h
X/* There are 6 different ways in which program lines are displayed. cf io.c */
X#define ONECODE 0
X#define TWOCODE 1
X#define TWOCODE_9 2
X#define TWOCODE_PT 3
X#define THREECODE 4
X#define THREECODE_PT 5
X
Xstruct KeyCode {
X   BYTE Type; /* The display method */
X   BYTE c1, c2, c3; /* The codes to display */
X};
X
X/* This array is indexed by the instruction code (from codes.h). Therefore, if
X  that file is changed, the codes must also be changed. */
Xextern struct KeyCode keycodes[];
SHAR_EOF
echo "extracting support.c"
sed 's/^X//' << \SHAR_EOF > support.c
X#include "math.h"
X
X#include "hp11/support.h"
X
Xdouble sign(r)
Xdouble r;
X{
X   if (r < 0.0) return(-1.0);
X   else if (r == 0.0) return (0.0);
X   else return(1.0);
X}
X
Xvoid Rect(r, phi, x, y)
Xdouble r, phi, *x, *y;
X{
X   *x = r * cos(phi);
X   *y = r * sin(phi);
X}
X
Xvoid Polar(x, y, r, phi)
Xdouble x, y, *r, *phi;
X{
X   *r = sqrt(x * x + y * y);
X   *phi = atan2(y, x);
X}
X
Xdouble stirling(n)
Xdouble n;
X{
X   double y = 1 / (12 * n);
X
X   return (pow(n / E, n) * sqrt(2 * PI * n) * (1 + y * (1 + y * (0.5 - y * (4.6333333333333333 + y * 4.7583333333333333)))));
X}
X
Xdouble gamma(x)
Xdouble x;
X{
X   double fx, tx, res, i;
X
X   if (x >= 15.0) return(stirling(x - 1));
X   else {
X      if ((fx = modf(x, &tx)) < 0) { tx -= 1.0; fx += 1.0; } /* give real int & frac */
X
X      if (fx == 0 && tx < 0) return(-HUGE);
X      if (tx < -200) return(0.0); /* Underflow */
X
X      res = stirling(fx + 14.0);
X      for (i = 14.0; i >= tx; i -= 1.0) res /= i + fx;
X
X      return(res);
X   }
X}
X
Xdouble factorial(x)
Xint x;
X{
X   double r = 1.0;
X
X   if (x > 250) r = HUGE; /* Certainly too big */
X   else for (; x > 0; x--) r *= x;
X
X   return(r);
X}
X
Xdouble Perm(x, y)
Xint x, y;
X{
X   double i, res = 1.0, lim = x - y;
X
X   for (i = x; i > lim; i -= 1.0) res *= i;
X
X   return(res);
X}
X
Xdouble Comb(x, y)
Xint x,y;
X{
X   double i, lim = y, res = Perm(x, y);
X
X   for (i = 1; i <= lim; i += 1.0) res /= i;
X
X   return(res);
X}
X
Xdouble hr(x)
Xdouble x;
X{
X   double h, m, s;
X
X   /* f = modf(x, &i) returns the frcational part of x in f and the integral part in i (all double) */
X   m = 100.0 * modf(x, &h);
X   s = 100.0 * modf(m, &m);
X
X   return(h + m / 60.0 + s / 3600.0);
X}
X
Xdouble hms(x)
Xdouble x;
X{
X   double h, m, s;
X
X   m = 60.0 * modf(x, &h);
X   s = 60.0 * modf(m, &m);
X
X   return(h + m / 100.0 + s / 10000.0);
X}
X
Xdouble trunc(x)
Xdouble x;
X{
X   modf(x, &x);
X   return(x);
X}
X
Xdouble frac(x)
Xdouble x;
X{
X   return(modf(x, &x));
X}
X
Xdouble asinh(x)
Xdouble x;
X{
X   return(log(x + sqrt(x * x + 1)));
X}
X
Xdouble acosh(x)
Xdouble x;
X{
X   if (x < 1.0) return(0.0);
X   else return(log(x + sqrt(x * x -1)));
X}
X
Xdouble atanh(x)
Xdouble x;
X{
X   if (x > 1.0) return(0.0);
X   else return(log((1.0 + x) / (1.0 - x)) / 2.0);
X}
SHAR_EOF
echo "extracting support.h"
sed 's/^X//' << \SHAR_EOF > support.h
X/* Support routines for the HP11, but not HP11 specific */
X
X/* Macros to convert to/from grad's/degrees from/to radians */
X#define TDEG(x) (x) * (180.0 / PI)
X#define FDEG(x) (x) * (PI / 180.0)
X#define TGRAD(x) (x) * (200.0 / PI)
X#define FGRAD(x) (x) * (PI / 200.0)
X#define E 2.718281828
X
Xdouble sign(double); /* return the sign of the number */
Xvoid Rect(double, double, double *, double *); /* Convert from Polar to Rectangular */
Xvoid Polar(double, double, double *, double *); /* Convert from Rectangular to Polar */
Xdouble Perm(int, int); /* Compute the permutation of y items taken x at a time (ordered) */
Xdouble Comb(int, int); /* Compute the combination of y items taken x at a time (unorderd) */
Xdouble hr(double); /* Convert to decimal hours */
Xdouble hms(double); /* Convert from decimal hours to hh.mmss */
Xdouble trunc(double); /* Truncate double, returning a double */
Xdouble frac(double); /* Take the fractional part of a double */
Xdouble factorial(int); /* Compute the factorial */
Xdouble gamma(double); /* Compute the gamma function */
Xdouble stirling(double); /* Stirling's approximation */
X/* Hyperbolic reciprocal functions (the others are in the library) */
Xdouble asinh(double), acosh(double), atanh(double);
SHAR_EOF
echo "End of archive 3 (of 3)"
# if you want to concatenate archives, remove anything after this line
exit